{$i-,s-,r-,g+}
unit realpict;
interface
uses pictures,dos;


type doublePicture=object(Picture)
	ScaleX,ScaleY:Double;
	Function Valid:Boolean; virtual;
	Function Save:Boolean; virtual;
	Procedure Load(ext:ExtStr); virtual;
	procedure Create(SizeX,SizeY:Word;pln:Word); virtual;
	Constructor Init;
	end;

Procedure PeekMask(var Obr1,Obr2:DoublePicture);
Procedure Mask(var Obr1,Obr2:DoublePicture);
Procedure SetRpixel(x,y:integer;p:doublepicture;n:double);
Function Rpixel(x,y:integer;p:doublepicture):double;


type MatlabHeader=record
	identif: longint;
	sizeX:	 longint;
	sizeY:	 longint;
	typ:	 longint;
	sizename:longint;
	end;

implementation
Constructor doublePicture.Init;
begin
 typ:='D';
 filename:=nil;
 data:=nil;
 x:=0;
 y:=0;
end;


Function Rpixel(x,y:integer;p:doublepicture):double;
begin
 if (x<0) then x:=0;
 if (y<0) then y:=0;
 if (x>=p.x) then x:=p.x-1;
 if (y>=p.y) then y:=p.y-1;
 Rpixel:=p.data^[y]^.D[x];
end;


Procedure SetRpixel(x,y:integer;p:doublepicture;n:double);
begin
 if ((x<0)or(y<0))or((x>=p.x)or(y>=p.y)) then exit;
 p.data^[y]^.D[x]:=n;
end;


Function doublePicture.Valid:Boolean;
begin
 Valid:=data<>nil;
end;


Procedure DoublePicture.Create(SizeX,SizeY:Word;pln:Word);
var i,LdBlk:Word;
begin
 picture.create(SizeX,SizeY,sizeof(double)*8+(pln and $FF00));
 scaleX:=1;
 scaleY:=1;
end;


Function SaveDblPictureTXT(var p:DoublePicture):Boolean;
var f:text;
    i,j:Word;
    s:single;
begin
 SaveDblPictureTXT:=False;
 if p.data=nil then exit;

 assign(f,p.filename^);
 rewrite(f);
 if(IOresult<>0) then exit;
 for i:=0 to p.x-1 do
   begin
   for j:=0 to p.y-1 do
       begin
       s:=rpixel(i,j,p);
       write(f,s,' ');
       end;
   writeln(f);
   end;

 close(f);
 if IOResult=0 then SaveDblPictureTXT:=True;
end;

Function SaveDblPictureMAT(var p:DoublePicture):Boolean;
var f:file;
    Head:MatlabHeader;
    i:Word;
    sizeline:Word;
begin
 SaveDblPictureMAT:=False;
 if p.data=nil then exit;

 assign(f,p.filename^);
 rewrite(f,1);
 if(IOresult<>0) then exit;
 sizeline:=length(p.filename^)-3;

 Head.identif:=0;
 Head.sizeX:=p.X;
 Head.sizeY:=p.Y;
 Head.typ:=0;		{real}
 Head.sizename:=sizeline;
 BlockWrite(f,Head,Sizeof(Head));	{hlavicka}

 p.filename^[Sizeline]:=#0;        {a jmeno promenne}
 BlockWrite(f,p.filename^[1],Sizeline);
 p.filename^[Head.SizeName]:='.';

 sizeline:=8*p.X;
 for i:=0 to p.y-1 do
       begin
       BlockWrite(f,p.data^[i]^.d,sizeline);
       end;

 close(f);
 if IOResult=0 then SaveDblPictureMAT:=True;
end;

Function DoublePicture.Save:Boolean;
var ext:string[4];
    i:Byte;
begin
 Save:=False;
 if Data=nil then exit;
 ext:=copy(filename^,length(filename^)-2,3);
 for i:=1 to 4 do ext[i]:=upcase(ext[i]);
 if ext='MAT' then Save:=SaveDblPictureMAT(self);
 if ext='TXT' then Save:=SaveDblPictureTXT(self);
end;

Function LoadDblPictureMAT(var p:DoublePicture):Boolean;
var f:file;
    Head:MatlabHeader;
    i:Word;
    Sizeline:Word;
begin
 LoadDblPictureMAT:=False;
 p.erase;

 assign(f,p.filename^);
 reset(f,1);
 if(IOresult<>0) then exit;

 BlockRead(f,Head,Sizeof(Head));	{hlavicka}
 if (Head.typ<>0)or(head.Typ<>0) then   {real}
                begin;close(f);exit;end;
 p.Create(Head.sizeX,Head.sizeY,1 or Nofill);

 BlockWrite(f,Head,Sizeof(Head));	{hlavicka}

 Seek(f,Head.SizeName+Sizeof(Head));    {preskoc jmeno promenne}

 sizeline:=8*p.X;
 for i:=0 to p.y-1 do
       begin
       BlockRead(f,p.data^[i]^.d,sizeline);
       end;

 close(f);
 if IOResult=0 then LoadDblPictureMAT:=True;
end;


Procedure DoublePicture.Load;
begin
 if Data=nil then exit;
 if ext='MAT' then LoadDblPictureMAT(self);
{ if ext='TXT' then Save:=SaveDblPictureTXT(self);}
end;


Procedure PeekMask(var Obr1,Obr2:DoublePicture);
var x,y:Word;
begin
 for x:=0 to Obr1.x-1 do
	for y:=0 to Obr1.y-1 do  setRpixel(x,y,Obr2,
	      (Rpixel(x-1,y-1,Obr1)+Rpixel(x,y-1,Obr1)+ Rpixel(x+1,y-1,Obr1)+
	       Rpixel(x-1,y,Obr1)+4*Rpixel(x,y,Obr1) +Rpixel(x+1,y,Obr1)+
	       Rpixel(x-1,y+1,Obr1)+Rpixel(x ,y+1,Obr1)+Rpixel(x+1,y+1,Obr1))/13);
end;

Procedure Mask(var Obr1,Obr2:DoublePicture);
var x,y:Word;
begin
 for x:=0 to Obr1.x-1 do
	for y:=0 to Obr1.y-1 do  setRpixel(x,y,Obr2,
	      (Rpixel(x-1,y-1,Obr1)+Rpixel(x,y-1,Obr1)+ Rpixel(x+1,y-1,Obr1)+
	       Rpixel(x-1,y,Obr1)+1*Rpixel(x,y,Obr1) +Rpixel(x+1,y,Obr1)+
	       Rpixel(x-1,y+1,Obr1)+Rpixel(x ,y+1,Obr1)+Rpixel(x+1,y+1,Obr1))/9);
end;

end.